perm filename DRAW.F4[DRW,LCS]2 blob
sn#334987 filedate 1978-02-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C00012 ENDMK
C⊗;
C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C*** DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
C*** ,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
C*** ,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
C PC=PLOT PX=XGP(→PLOT.BIN) PXS,PCS=PLOT SMOOTHED CONTURE
C PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
COMMON /RC/MCLEF(400),IST(4000)
COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
1 ,(NMLST,IST(1510)),(JST,IST(500))
DATA RJB/-20./,CENTR/-26./
RSZ=0
1 MCLEF(1)=0
MM=0
IPLT=0
IPLTX=-1
K=1
91 TYPE 100
55 FORMAT(I,2F)
50 FORMAT(3A1)
XSZ=RSZ
ACCEPT 55,J,RSZ,GRID
IF(RSZ.EQ.0)RSZ=XSZ
MORE=-1
REREAD 50,N,JC,JS
IF(N.EQ.' ')GO TO 91
C PXS,PCS=SMOOTH ONLY; PXZ,PCZ=SMOOTH AND FILL
C TO SAVE SIZE FACTOR WHEN REDRAWING.
IF(N.EQ.'Z')GO TO 1
IF(RSZ.EQ.0)RSZ=9.0
IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
IF(N.EQ.'M'.OR.N.EQ.'R')GO TO 192
IF(N.EQ.'V')CALL CNVT
C V=CONVERT FROM OLD FORMAT TO NEW.
C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
IF(N.EQ.'F')GO TO 79
C FILLS IT.
IF(JS.EQ.'L')N='Z'
C DEL=DELETE FROM COMB. FILE. (JS='L')
IF(N.EQ.'C'.OR.N.EQ.'A'.OR.N.EQ.'Z')GO TO 999
CC IF(N.EQ.'X')CALL EXIT
IF(N.EQ.'Q')GO TO 56
C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
CC IF(JC.EQ.'X')MCLEF(1)=0
C TYPE 'DX' TO START NEW DRAWING WITHOUT EXIT. (GOOD AFTER 'Q')
KED=N
MM=MCLEF(1)
IF(MM.NE.0)GO TO 92
C ADD TO DRAWING?
GO TO 3
56 CALL POG2
CALL RDRAW(2,MCLEF(1),MCLEF)
CALL DPYOUT(2)
CALL POG1
GO TO 91
999 CALL CMBN
GO TO 111
CC192 IF(N.EQ.'R')MCLEF(1)=-MCLEF(1)
192 CALL SHIFT(MCLEF(2),MCLEF(1),N)
J=1
JC=0
GO TO 333
291 FORMAT(A2,A5)
191 REREAD 291,NM,NM
IF(NM.NE.' ')GO TO 293
TYPE 41
IF(JC.EQ.'M')GO TO 194
IF(N.EQ.'S')GO TO 194
MCLEF(1)=0
MM=0
IPLTX=-1
K=1
194 IF(JC.EQ.'M')MORE=0
JQ=JC
JC=0
JM=1
IF(MCLEF(1).EQ.0)GO TO 193
CC JC=JCLEF(2)-1
CC JM=MCLEF(1)+1
JM=MCLEF(1)+1
193 ACCEPT 10,NM,PASS
IF(NM.EQ.' ')NM=LASTNM
IF(NM.EQ.' ')GO TO 91
IF(NM.EQ.'99')GO TO 91
C '99' WILL BACKUP
293 IF(N.NE.'S')LASTNM=NM
CC REWIND 1
IF(N.EQ.'S')GO TO 40
IF(LOOKF(NM).EQ.0)GO TO 191
C 'FAIL' ROUTINE TO CHECK ON LOOKUP
CC CALL IFILE(1,NM)
CC READ(1,5)M,JCLEF
CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
C -1=READ
C CAN'T USE 'GM' WITH 'COMBINED' FILE.
CC JQ=0
CC IF(MORE.EQ.0.AND.JCLEF(3).NE.0)JQ=JM-1
J=1
IF(KCLEF(2).EQ.0)GO TO 290
CC IF(PASS.NE.0)CALL ITEM
TYPE 1100
ACCEPT 55,J
J=J+1
C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
IF(J.GT.10)GO TO 191
CC290 IC=KCLEF(K+1)-KCLEF(K)
290 IC=KCLEF(J)+JST(KCLEF(J))-1
CC IF(J.EQ.10)IC=1000
TYPE 110,IC
60 JZ=1
IF(MORE.EQ.0)JZ=JM
L=KCLEF(J)-1
M=JST(L+1)+JZ-1
IF(MORE.NE.0)GO TO 161
M=M-1
L=L+1
161 DO 61 K=JZ,M
L=L+1
CJ M=K
61 MCLEF(K)=JST(L)
MCLEF(1)=M
1100 FORMAT(' ITEM NUM?'/)
700 FORMAT(' RESET X-Y POS. ',$)
555 FORMAT(2F)
7 IF(MORE)GO TO 70
DO 771 K=2,JM-1
771 IF(MCLEF(K).GE.200000000)GO TO 772
GO TO 70
C PUTS FILLER TO END
C MOVES OUTLINE UP FRONT
772 M=MCLEF(1)
DO 773 L=K,JM
M=M+1
773 MCLEF(M)=MCLEF(L)
CJ K=MJ+K
K=JM-K
1774 DO 774 L=JM,M
774 MCLEF(L-K)=MCLEF(L)
GO TO 3
70 IF(N.NE.'P')GO TO 3
IXRX=-1
IF(JQ.NE.'X')IXRX=0
C 0=SEND IT TO CALCOMP
TYPE 700
ACCEPT 555,X,Y
IF(X.NE.0)RJB=X/RSZ
IF(Y.NE.0)CENTR=Y/RSZ
C TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
IF(IPLTX)CALL PLOTS(0)
C DO I NEED THIS?
IF(GRID.GT.0)CALL GRIDS
IPLTX=0
IPLT=-1
3 IF(N.NE.'D')MM=0
C RESET IF NOT GOING TO DRAWIT
333 IF(N.EQ.'P')GO TO 337
CALL DPYSET(1,IST,4000)
CALL DPYBRT(4)
NIST=IST(2)
IF(N.GE.0)GO TO 337
IF(N.EQ.'G')GO TO 337
IF(N.EQ.'M')GO TO 337
IF(N.NE.'R')GO TO 92
CC337 JJ=MCLEF(1)
337 IF(JS.EQ.'Z')GO TO 306
IF(JS.NE.'S')GO TO 338
CALL SMOOTH(JS)
GO TO 436
338 IC=-1
MM=1
DO 335 K=2,MCLEF(1)
IF(MCLEF(K).LT.200000000)GO TO 335
CC CALL DPYBRT(3)
CC CALL RDRAW(K,MCLEF(1),MCLEF)
CC CALL DPYOUT(1)
CC CALL DPYBRT(4)
CC JJ=K-1
IC=K
GO TO 334
C FOR 1ST LOC. OF MCLEF IN FILLER
335 CONTINUE
334 CALL RDRAW(2,MCLEF(1),MCLEF)
CALL DPYOUT(1)
NIST=IST(2)
CC IF(JJ.EQ.MCLEF(1))GO TO 436
GO TO 436
C NO FILLER
79 IF(IC)GO TO 91
C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
CJ TYPE 336
CJ ACCEPT 10,J
JZ=N
CC IF(J.NE.'Y'.AND.J.NE.'S')GO TO 436
KK=0
CJ IF(J.NE.'Y')GO TO 206
IF(JC.NE.'S')GO TO 206
C TYPE 'FS' TO FILL AND SMOOTH
CC IF(J.NE.'S')GO TO 206
306 CALL SMOOTH(0)
C SMOOTHS AND FILLS
GO TO 436
206 RR=RSZ
DO 205 J=IC,MCLEF(1)
CALL UNPACK(J,M,N,MCLEF)
KK=KK+1
NF(KK)=0
IF(LL.GE.100000000)NF(KK)=3
QF(KK)=(M+RJB)*RR
205 RF(KK)=(N+CENTR)*RR
NF(1)=KK
CALL FILLQ(QF,RF,NF)
436 IF(JZ.EQ.'P')CALL PLOT(0,0,3)
GO TO 91
66 TYPE 666,NM
GO TO 91
666 FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
336 FORMAT(' SMOOTH? ',$)
10 FORMAT(A5,F)
5 FORMAT(12I)
100 FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
1, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
1' F=FILL, E=EDIT, N1=SIZE, N2=1=GRID '/)
C N1=20 TO CHANGE SHAPE
92 IST(2)=NIST
CALL DRAWIT
N=0
GO TO 3
403 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
41 FORMAT(' TYPE FILE NAME'/)
C SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
40 IF(LOOKF(NM).EQ.0)GO TO 402
TYPE 403,NM
ACCEPT 50,K
IF(K.EQ.'N')GO TO 191
CC402 IC=MCLEF(1)+1
402 NMLST(1)=NM
JCLEF(1)=1
DO 1111 K=2,10
JCLEF(K)=0
1111 NMLST(K)=' '
CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
NQ=MCLEF(1)
CC CALL OFILE(1,NM)
CC WRITE(1,120),IC
CC CALL SAVE(MCLEF)
CC WRITE(1,1111)NM
CC1111 FORMAT(' 9999 ',A5)
111 TYPE 110,NQ
CC END FILE(1)
CC TYPE 1111,NM
GO TO 91
CC120 FORMAT(' 9999 1 ',I4,' 0 0 0 0 0 0 0 0')
110 FORMAT(' TOTAL WDS=',I3)
END